home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tkSelect.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-05-11  |  72.2 KB  |  2,519 lines
  1. /* 
  2.  * tkSelect.c --
  3.  *
  4.  *    This file manages the selection for the Tk toolkit,
  5.  *    translating between the standard X ICCCM conventions
  6.  *    and Tcl commands.
  7.  *
  8.  * Copyright (c) 1990-1993 The Regents of the University of California.
  9.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  */
  14.  
  15. static char sccsid[] = "@(#) tkSelect.c 1.47 95/05/11 09:37:15";
  16.  
  17. #include "tkPort.h"
  18. #include "tkInt.h"
  19.  
  20. /*
  21.  * When a selection is owned by a window on a given display, one of the
  22.  * following structures is present on a list of current selections in the
  23.  * display structure.  The structure is used to record the current owner of
  24.  * a selection for use in later retrieval requests.  There is a list of
  25.  * such structures because a display can have multiple different selections
  26.  * active at the same time.
  27.  */
  28.  
  29. typedef struct TkSelectionInfo {
  30.     Atom selection;        /* Selection name, e.g. XA_PRIMARY. */
  31.     Tk_Window owner;        /* Current owner of this selection. */
  32.     int serial;            /* Serial number of last XSelectionSetOwner
  33.                  * request made to server for this
  34.                  * selection (used to filter out redundant
  35.                  * SelectionClear events). */
  36.     Time time;            /* Timestamp used to acquire selection. */
  37.     Tk_LostSelProc *clearProc;    /* Procedure to call when owner loses
  38.                  * selection. */
  39.     ClientData clearData;    /* Info to pass to clearProc. */
  40.     struct TkSelectionInfo *nextPtr;
  41.                 /* Next in list of current selections on
  42.                                  * this display.  NULL means end of list */
  43. } TkSelectionInfo;
  44.  
  45. /*
  46.  * One of the following structures exists for each selection handler
  47.  * created for a window by calling Tk_CreateSelHandler.  The handlers
  48.  * are linked in a list rooted in the TkWindow structure.
  49.  */
  50.  
  51. typedef struct TkSelHandler {
  52.     Atom selection;        /* Selection name, e.g. XA_PRIMARY */
  53.     Atom target;        /* Target type for selection
  54.                  * conversion, such as TARGETS or
  55.                  * STRING. */
  56.     Atom format;        /* Format in which selection
  57.                  * info will be returned, such
  58.                  * as STRING or ATOM. */
  59.     Tk_SelectionProc *proc;    /* Procedure to generate selection
  60.                  * in this format. */
  61.     ClientData clientData;    /* Argument to pass to proc. */
  62.     int size;            /* Size of units returned by proc
  63.                  * (8 for STRING, 32 for almost
  64.                  * anything else). */
  65.     struct TkSelHandler *nextPtr;
  66.                 /* Next selection handler associated
  67.                  * with same window (NULL for end of
  68.                  * list). */
  69. } TkSelHandler;
  70.  
  71. /*
  72.  * When the selection is being retrieved, one of the following
  73.  * structures is present on a list of pending selection retrievals.
  74.  * The structure is used to communicate between the background
  75.  * procedure that requests the selection and the foreground
  76.  * event handler that processes the events in which the selection
  77.  * is returned.  There is a list of such structures so that there
  78.  * can be multiple simultaneous selection retrievals (e.g. on
  79.  * different displays).
  80.  */
  81.  
  82. typedef struct RetrievalInfo {
  83.     Tcl_Interp *interp;        /* Interpreter for error reporting. */
  84.     TkWindow *winPtr;        /* Window used as requestor for
  85.                  * selection. */
  86.     Atom selection;        /* Selection being requested. */
  87.     Atom property;        /* Property where selection will appear. */
  88.     Atom target;        /* Desired form for selection. */
  89.     int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
  90.     char *portion));    /* Procedure to call to handle pieces
  91.                  * of selection. */
  92.     ClientData clientData;    /* Argument for proc. */
  93.     int result;            /* Initially -1.  Set to a Tcl
  94.                  * return value once the selection
  95.                  * has been retrieved. */
  96.     Tk_TimerToken timeout;    /* Token for current timeout procedure. */
  97.     int idleTime;        /* Number of seconds that have gone by
  98.                  * without hearing anything from the
  99.                  * selection owner. */
  100.     struct RetrievalInfo *nextPtr;
  101.                 /* Next in list of all pending
  102.                  * selection retrievals.  NULL means
  103.                  * end of list. */
  104. } RetrievalInfo;
  105.  
  106. static RetrievalInfo *pendingRetrievals = NULL;
  107.                 /* List of all retrievals currently
  108.                  * being waited for. */
  109.  
  110. /*
  111.  * When handling INCR-style selection retrievals, the selection owner
  112.  * uses the following data structure to communicate between the
  113.  * ConvertSelection procedure and TkSelPropProc.
  114.  */
  115.  
  116. typedef struct IncrInfo {
  117.     TkWindow *winPtr;        /* Window that owns selection. */
  118.     Atom selection;        /* Selection that is being retrieved. */
  119.     Atom *multAtoms;        /* Information about conversions to
  120.                  * perform:  one or more pairs of
  121.                  * (target, property).  This either
  122.                  * points to a retrieved  property (for
  123.                  * MULTIPLE retrievals) or to a static
  124.                  * array. */
  125.     unsigned long numConversions;
  126.                 /* Number of entries in offsets (same as
  127.                  * # of pairs in multAtoms). */
  128.     int *offsets;        /* One entry for each pair in
  129.                  * multAtoms;  -1 means all data has
  130.                  * been transferred for this
  131.                  * conversion.  -2 means only the
  132.                  * final zero-length transfer still
  133.                  * has to be done.  Otherwise it is the
  134.                  * offset of the next chunk of data
  135.                  * to transfer.  This array is malloc-ed. */
  136.     int numIncrs;        /* Number of entries in offsets that
  137.                  * aren't -1 (i.e. # of INCR-mode transfers
  138.                  * not yet completed). */
  139.     Tk_TimerToken timeout;    /* Token for timer procedure. */
  140.     int idleTime;        /* Number of seconds since we heard
  141.                  * anything from the selection
  142.                  * requestor. */
  143.     Window reqWindow;        /* Requestor's window id. */
  144.     Time time;            /* Timestamp corresponding to
  145.                  * selection at beginning of request;
  146.                  * used to abort transfer if selection
  147.                  * changes. */
  148.     struct IncrInfo *nextPtr;    /* Next in list of all INCR-style
  149.                  * retrievals currently pending. */
  150. } IncrInfo;
  151.  
  152. static IncrInfo *pendingIncrs = NULL;
  153.                 /* List of all incr structures
  154.                  * currently active. */
  155.  
  156. /*
  157.  * When a selection handler is set up by invoking "selection handle",
  158.  * one of the following data structures is set up to hold information
  159.  * about the command to invoke and its interpreter.
  160.  */
  161.  
  162. typedef struct {
  163.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  164.     int cmdLength;        /* # of non-NULL bytes in command. */
  165.     char command[4];        /* Command to invoke.  Actual space is
  166.                  * allocated as large as necessary.  This
  167.                  * must be the last entry in the structure. */
  168. } CommandInfo;
  169.  
  170. /*
  171.  * When selection ownership is claimed with the "selection own" Tcl command,
  172.  * one of the following structures is created to record the Tcl command
  173.  * to be executed when the selection is lost again.
  174.  */
  175.  
  176. typedef struct LostCommand {
  177.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  178.     char command[4];        /* Command to invoke.  Actual space is
  179.                  * allocated as large as necessary.  This
  180.                  * must be the last entry in the structure. */
  181. } LostCommand;
  182.  
  183. /*
  184.  * It is possible for a Tk_SelectionProc to delete the handler that it
  185.  * represents.  If this happens, the code that is retrieving the selection
  186.  * needs to know about it so it doesn't use the now-defunct handler
  187.  * structure.  One structure of the following form is created for each
  188.  * retrieval in progress, so that the retriever can find out if its
  189.  * handler is deleted.  All of the pending retrievals (if there are more
  190.  * than one) are linked into a list.
  191.  */
  192.  
  193. typedef struct InProgress {
  194.     TkSelHandler *selPtr;    /* Handler being executed.  If this handler
  195.                  * is deleted, the field is set to NULL. */
  196.     struct InProgress *nextPtr; /* Next higher nested search. */
  197. } InProgress;
  198.  
  199. static InProgress *pendingPtr = NULL;
  200.                 /* Topmost search in progress, or
  201.                  * NULL if none. */
  202.  
  203. /*
  204.  * Chunk size for retrieving selection.  It's defined both in
  205.  * words and in bytes;  the word size is used to allocate
  206.  * buffer space that's guaranteed to be word-aligned and that
  207.  * has an extra character for the terminating NULL.
  208.  */
  209.  
  210. #define TK_SEL_BYTES_AT_ONCE 4000
  211. #define TK_SEL_WORDS_AT_ONCE 1001
  212.  
  213. /*
  214.  * Largest property that we'll accept when sending or receiving the
  215.  * selection:
  216.  */
  217.  
  218. #define MAX_PROP_WORDS 100000
  219.  
  220. /*
  221.  * Forward declarations for procedures defined in this file:
  222.  */
  223.  
  224. static void        ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
  225.                 XSelectionRequestEvent *eventPtr));
  226. static int        DefaultSelection _ANSI_ARGS_((
  227.                 TkSelectionInfo *infoPtr, Atom target,
  228.                 char *buffer, int maxBytes, Atom *typePtr));
  229. static int        HandleTclCommand _ANSI_ARGS_((ClientData clientData,
  230.                 int offset, char *buffer, int maxBytes));
  231. static void        IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
  232. static void        LostSelection _ANSI_ARGS_((ClientData clientData));
  233. static char *        SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
  234.                 Atom type, Tk_Window tkwin));
  235. static long *        SelCvtToX _ANSI_ARGS_((char *string, Atom type,
  236.                 Tk_Window tkwin, int *numLongsPtr));
  237. static int        SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
  238. static int        SelGetProc _ANSI_ARGS_((ClientData clientData,
  239.                 Tcl_Interp *interp, char *portion));
  240. static void        SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
  241.                 XEvent *eventPtr));
  242. static void        SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
  243.  
  244. /*
  245.  *--------------------------------------------------------------
  246.  *
  247.  * Tk_CreateSelHandler --
  248.  *
  249.  *    This procedure is called to register a procedure
  250.  *    as the handler for selection requests of a particular
  251.  *    target type on a particular window for a particular
  252.  *    selection.
  253.  *
  254.  * Results:
  255.  *    None.
  256.  *
  257.  * Side effects:
  258.  *    In the future, whenever the selection is in tkwin's
  259.  *    window and someone requests the selection in the
  260.  *    form given by target, proc will be invoked to provide
  261.  *    part or all of the selection in the given form.  If
  262.  *    there was already a handler declared for the given
  263.  *    window, target and selection type, then it is replaced.
  264.  *    Proc should have the following form:
  265.  *
  266.  *    int
  267.  *    proc(clientData, offset, buffer, maxBytes)
  268.  *        ClientData clientData;
  269.  *        int offset;
  270.  *        char *buffer;
  271.  *        int maxBytes;
  272.  *    {
  273.  *    }
  274.  *
  275.  *    The clientData argument to proc will be the same as
  276.  *    the clientData argument to this procedure.  The offset
  277.  *    argument indicates which portion of the selection to
  278.  *    return:  skip the first offset bytes.  Buffer is a
  279.  *    pointer to an area in which to place the converted
  280.  *    selection, and maxBytes gives the number of bytes
  281.  *    available at buffer.  Proc should place the selection
  282.  *    in buffer as a string, and return a count of the number
  283.  *    of bytes of selection actually placed in buffer (not
  284.  *    including the terminating NULL character).  If the
  285.  *    return value equals maxBytes, this is a sign that there
  286.  *    is probably still more selection information available.
  287.  *
  288.  *--------------------------------------------------------------
  289.  */
  290.  
  291. void
  292. Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format)
  293.     Tk_Window tkwin;        /* Token for window. */
  294.     Atom selection;        /* Selection to be handled. */
  295.     Atom target;        /* The kind of selection conversions
  296.                  * that can be handled by proc,
  297.                  * e.g. TARGETS or STRING. */
  298.     Tk_SelectionProc *proc;    /* Procedure to invoke to convert
  299.                  * selection to type "target". */
  300.     ClientData clientData;    /* Value to pass to proc. */
  301.     Atom format;        /* Format in which the selection
  302.                  * information should be returned to
  303.                  * the requestor. XA_STRING is best by
  304.                  * far, but anything listed in the ICCCM
  305.                  * will be tolerated (blech). */
  306. {
  307.     register TkSelHandler *selPtr;
  308.     TkWindow *winPtr = (TkWindow *) tkwin;
  309.  
  310.     if (winPtr->dispPtr->multipleAtom == None) {
  311.     TkSelInit(tkwin);
  312.     }
  313.  
  314.     /*
  315.      * See if there's already a handler for this target and selection on
  316.      * this window.  If so, re-use it.  If not, create a new one.
  317.      */
  318.  
  319.     for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
  320.     if (selPtr == NULL) {
  321.         selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
  322.         selPtr->nextPtr = winPtr->selHandlerList;
  323.         winPtr->selHandlerList = selPtr;
  324.         break;
  325.     }
  326.     if ((selPtr->selection == selection) && (selPtr->target == target)) {
  327.  
  328.         /*
  329.          * Special case:  when replacing handler created by
  330.          * "selection handle", free up memory.  Should there be a
  331.          * callback to allow other clients to do this too?
  332.          */
  333.  
  334.         if (selPtr->proc == HandleTclCommand) {
  335.         ckfree((char *) selPtr->clientData);
  336.         }
  337.         break;
  338.     }
  339.     }
  340.     selPtr->selection = selection;
  341.     selPtr->target = target;
  342.     selPtr->format = format;
  343.     selPtr->proc = proc;
  344.     selPtr->clientData = clientData;
  345.     if (format == XA_STRING) {
  346.     selPtr->size = 8;
  347.     } else {
  348.     selPtr->size = 32;
  349.     }
  350. }
  351.  
  352. /*
  353.  *----------------------------------------------------------------------
  354.  *
  355.  * Tk_DeleteSelHandler --
  356.  *
  357.  *    Remove the selection handler for a given window, target, and
  358.  *    selection, if it exists.
  359.  *
  360.  * Results:
  361.  *    None.
  362.  *
  363.  * Side effects:
  364.  *    The selection handler for tkwin and target is removed.  If there
  365.  *    is no such handler then nothing happens.
  366.  *
  367.  *----------------------------------------------------------------------
  368.  */
  369.  
  370. void
  371. Tk_DeleteSelHandler(tkwin, selection, target)
  372.     Tk_Window tkwin;            /* Token for window. */
  373.     Atom selection;            /* The selection whose handler
  374.                      * is to be removed. */
  375.     Atom target;            /* The target whose selection
  376.                      * handler is to be removed. */
  377. {
  378.     TkWindow *winPtr = (TkWindow *) tkwin;
  379.     register TkSelHandler *selPtr, *prevPtr;
  380.     register InProgress *ipPtr;
  381.  
  382.     /*
  383.      * Find the selection handler to be deleted, or return if it doesn't
  384.      * exist.
  385.      */ 
  386.  
  387.     for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
  388.         prevPtr = selPtr, selPtr = selPtr->nextPtr) {
  389.     if (selPtr == NULL) {
  390.         return;
  391.     }
  392.     if ((selPtr->selection == selection) && (selPtr->target == target)) {
  393.         break;
  394.     }
  395.     }
  396.  
  397.     /*
  398.      * If ConvertSelection is processing this handler, tell it that the
  399.      * handler is dead.
  400.      */
  401.  
  402.     for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
  403.     if (ipPtr->selPtr == selPtr) {
  404.         ipPtr->selPtr = NULL;
  405.     }
  406.     }
  407.  
  408.     /*
  409.      * Free resources associated with the handler.
  410.      */
  411.  
  412.     if (prevPtr == NULL) {
  413.     winPtr->selHandlerList = selPtr->nextPtr;
  414.     } else {
  415.     prevPtr->nextPtr = selPtr->nextPtr;
  416.     }
  417.     if (selPtr->proc == HandleTclCommand) {
  418.     ckfree((char *) selPtr->clientData);
  419.     }
  420.     ckfree((char *) selPtr);
  421. }
  422.  
  423. /*
  424.  *--------------------------------------------------------------
  425.  *
  426.  * Tk_OwnSelection --
  427.  *
  428.  *    Arrange for tkwin to become the owner of a selection.
  429.  *
  430.  * Results:
  431.  *    None.
  432.  *
  433.  * Side effects:
  434.  *    From now on, requests for the selection will be directed
  435.  *    to procedures associated with tkwin (they must have been
  436.  *    declared with calls to Tk_CreateSelHandler).  When the
  437.  *    selection is lost by this window, proc will be invoked
  438.  *    (see the manual entry for details).  This procedure may
  439.  *    invoke callbacks, including Tcl scripts, so any calling
  440.  *    function should be reentrant at the point where
  441.  *    Tk_OwnSelection is invoked.
  442.  *
  443.  *--------------------------------------------------------------
  444.  */
  445.  
  446. void
  447. Tk_OwnSelection(tkwin, selection, proc, clientData)
  448.     Tk_Window tkwin;        /* Window to become new selection
  449.                  * owner. */
  450.     Atom selection;        /* Selection that window should own. */
  451.     Tk_LostSelProc *proc;    /* Procedure to call when selection
  452.                  * is taken away from tkwin. */
  453.     ClientData clientData;    /* Arbitrary one-word argument to
  454.                  * pass to proc. */
  455. {
  456.     register TkWindow *winPtr = (TkWindow *) tkwin;
  457.     TkDisplay *dispPtr = winPtr->dispPtr;
  458.     TkSelectionInfo *infoPtr;
  459.     Tk_LostSelProc *clearProc = NULL;
  460.     ClientData clearData = NULL;    /* Initialization needed only to
  461.                      * prevent compiler warning. */
  462.     
  463.     
  464.     if (dispPtr->multipleAtom == None) {
  465.     TkSelInit(tkwin);
  466.     }
  467.     Tk_MakeWindowExist(tkwin);
  468.  
  469.     /*
  470.      * This code is somewhat tricky.  First, we find the specified selection
  471.      * on the selection list.  If the previous owner is in this process, and
  472.      * is a different window, then we need to invoke the clearProc.  However,
  473.      * it's dangerous to call the clearProc right now, because it could
  474.      * invoke a Tcl script that wrecks the current state (e.g. it could
  475.      * delete the window).  To be safe, defer the call until the end of the
  476.      * procedure when we no longer care about the state.
  477.      */
  478.  
  479.     for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
  480.         infoPtr = infoPtr->nextPtr) {
  481.     if (infoPtr->selection == selection) {
  482.         break;
  483.     }
  484.     }
  485.     if (infoPtr == NULL) {
  486.     infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
  487.     infoPtr->selection = selection;
  488.     infoPtr->owner = tkwin;
  489.     infoPtr->nextPtr = dispPtr->selectionInfoPtr;
  490.     dispPtr->selectionInfoPtr = infoPtr;
  491.     } else if ((infoPtr->owner != tkwin) && (infoPtr->clearProc != NULL)) {
  492.     clearProc = infoPtr->clearProc;
  493.     clearData = infoPtr->clearData;
  494.     }
  495.  
  496.     infoPtr->owner = tkwin;
  497.     infoPtr->serial = NextRequest(winPtr->display);
  498.     infoPtr->clearProc = proc;
  499.     infoPtr->clearData = clientData;
  500.  
  501.     /*
  502.      * Note that we are using CurrentTime, even though ICCCM recommends against
  503.      * this practice (the problem is that we don't necessarily have a valid
  504.      * time to use).  We will not be able to retrieve a useful timestamp for
  505.      * the TIMESTAMP target later.
  506.      */
  507.  
  508.     infoPtr->time = CurrentTime;
  509.  
  510.     /*
  511.      * Note that we are not checking to see if the selection claim succeeded.
  512.      * If the ownership does not change, then the clearProc may never be
  513.      * invoked, and we will return incorrect information when queried for the
  514.      * current selection owner.
  515.      */
  516.  
  517.     XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
  518.         infoPtr->time);
  519.  
  520.     /*
  521.      * Now that we are done, we can invoke clearProc without running into
  522.      * reentrancy problems.
  523.      */
  524.  
  525.     if (clearProc != NULL) {
  526.     (*clearProc)(clearData);
  527.     }
  528. }
  529.  
  530. /*
  531.  *----------------------------------------------------------------------
  532.  *
  533.  * Tk_ClearSelection --
  534.  *
  535.  *    Eliminate the specified selection on tkwin's display, if there is one.
  536.  *
  537.  * Results:
  538.  *    None.
  539.  *
  540.  * Side effects:
  541.  *    The specified selection is cleared, so that future requests to retrieve
  542.  *    it will fail until some application owns it again.  This procedure
  543.  *    invokes callbacks, possibly including Tcl scripts, so any calling
  544.  *    function should be reentrant at the point Tk_ClearSelection is invoked.
  545.  *
  546.  *----------------------------------------------------------------------
  547.  */
  548.  
  549. void
  550. Tk_ClearSelection(tkwin, selection)
  551.     Tk_Window tkwin;        /* Window that selects a display. */
  552.     Atom selection;        /* Selection to be cancelled. */
  553. {
  554.     register TkWindow *winPtr = (TkWindow *) tkwin;
  555.     TkDisplay *dispPtr = winPtr->dispPtr;
  556.     TkSelectionInfo *infoPtr;
  557.     TkSelectionInfo *prevPtr;
  558.     TkSelectionInfo *nextPtr;
  559.     Tk_LostSelProc *clearProc = NULL;
  560.     ClientData clearData = NULL;    /* Initialization needed only to
  561.                      * prevent compiler warning. */
  562.  
  563.     if (dispPtr->multipleAtom == None) {
  564.     TkSelInit(tkwin);
  565.     }
  566.  
  567.     for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
  568.          infoPtr != NULL; infoPtr = nextPtr) {
  569.     nextPtr = infoPtr->nextPtr;
  570.     if (infoPtr->selection == selection) {
  571.         if (prevPtr == NULL) {
  572.         dispPtr->selectionInfoPtr = nextPtr;
  573.         } else {
  574.         prevPtr->nextPtr = nextPtr;
  575.         }
  576.         break;
  577.     }
  578.     prevPtr = infoPtr;
  579.     }
  580.     
  581.     if (infoPtr != NULL) {
  582.     clearProc = infoPtr->clearProc;
  583.     clearData = infoPtr->clearData;
  584.     ckfree((char *) infoPtr);
  585.     }
  586.     XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
  587.  
  588.     if (clearProc != NULL) {
  589.     (*clearProc)(clearData);
  590.     }
  591. }
  592.  
  593. /*
  594.  *--------------------------------------------------------------
  595.  *
  596.  * Tk_GetSelection --
  597.  *
  598.  *    Retrieve the value of a selection and pass it off (in
  599.  *    pieces, possibly) to a given procedure.
  600.  *
  601.  * Results:
  602.  *    The return value is a standard Tcl return value.
  603.  *    If an error occurs (such as no selection exists)
  604.  *    then an error message is left in interp->result.
  605.  *
  606.  * Side effects:
  607.  *    The standard X11 protocols are used to retrieve the
  608.  *    selection.  When it arrives, it is passed to proc.  If
  609.  *    the selection is very large, it will be passed to proc
  610.  *    in several pieces.  Proc should have the following
  611.  *    structure:
  612.  *
  613.  *    int
  614.  *    proc(clientData, interp, portion)
  615.  *        ClientData clientData;
  616.  *        Tcl_Interp *interp;
  617.  *        char *portion;
  618.  *    {
  619.  *    }
  620.  *
  621.  *    The interp and clientData arguments to proc will be the
  622.  *    same as the corresponding arguments to Tk_GetSelection.
  623.  *    The portion argument points to a character string
  624.  *    containing part of the selection, and numBytes indicates
  625.  *    the length of the portion, not including the terminating
  626.  *    NULL character.  If the selection arrives in several pieces,
  627.  *    the "portion" arguments in separate calls will contain
  628.  *    successive parts of the selection.  Proc should normally
  629.  *    return TCL_OK.  If it detects an error then it should return
  630.  *    TCL_ERROR and leave an error message in interp->result; the
  631.  *    remainder of the selection retrieval will be aborted.
  632.  *
  633.  *--------------------------------------------------------------
  634.  */
  635.  
  636. int
  637. Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
  638.     Tcl_Interp *interp;        /* Interpreter to use for reporting
  639.                  * errors. */
  640.     Tk_Window tkwin;        /* Window on whose behalf to retrieve
  641.                  * the selection (determines display
  642.                  * from which to retrieve). */
  643.     Atom selection;        /* Selection to retrieve. */
  644.     Atom target;        /* Desired form in which selection
  645.                  * is to be returned. */
  646.     Tk_GetSelProc *proc;    /* Procedure to call to process the
  647.                  * selection, once it has been retrieved. */
  648.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  649. {
  650.     RetrievalInfo retr;
  651.     TkWindow *winPtr = (TkWindow *) tkwin;
  652.     TkDisplay *dispPtr = winPtr->dispPtr;
  653.     TkSelectionInfo *infoPtr;
  654.  
  655.     if (dispPtr->multipleAtom == None) {
  656.     TkSelInit(tkwin);
  657.     }
  658.  
  659.     /*
  660.      * If the selection is owned by a window managed by this
  661.      * process, then call the retrieval procedure directly,
  662.      * rather than going through the X server (it's dangerous
  663.      * to go through the X server in this case because it could
  664.      * result in deadlock if an INCR-style selection results).
  665.      */
  666.  
  667.     for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
  668.         infoPtr = infoPtr->nextPtr) {
  669.     if (infoPtr->selection == selection)
  670.         break;
  671.     }
  672.     if (infoPtr != NULL) {
  673.     register TkSelHandler *selPtr;
  674.     int offset, result, count;
  675.     char buffer[TK_SEL_BYTES_AT_ONCE+1];
  676.     InProgress ip;
  677.  
  678.     for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
  679.         selPtr != NULL; selPtr = selPtr->nextPtr) {
  680.         if ((selPtr->target == target)
  681.             && (selPtr->selection == selection)) {
  682.         break;
  683.         }
  684.     }
  685.     if (selPtr == NULL) {
  686.         Atom type;
  687.  
  688.         count = DefaultSelection(infoPtr, target, buffer,
  689.             TK_SEL_BYTES_AT_ONCE, &type);
  690.         if (count > TK_SEL_BYTES_AT_ONCE) {
  691.         panic("selection handler returned too many bytes");
  692.         }
  693.         if (count < 0) {
  694.         goto cantget;
  695.         }
  696.         buffer[count] = 0;
  697.         result = (*proc)(clientData, interp, buffer);
  698.     } else {
  699.         offset = 0;
  700.         result = TCL_OK;
  701.         ip.selPtr = selPtr;
  702.         ip.nextPtr = pendingPtr;
  703.         pendingPtr = &ip;
  704.         while (1) {
  705.         count = (selPtr->proc)(selPtr->clientData, offset, buffer,
  706.             TK_SEL_BYTES_AT_ONCE);
  707.         if ((count < 0) || (ip.selPtr == NULL)) {
  708.             pendingPtr = ip.nextPtr;
  709.             goto cantget;
  710.         }
  711.         if (count > TK_SEL_BYTES_AT_ONCE) {
  712.             panic("selection handler returned too many bytes");
  713.         }
  714.         buffer[count] = '\0';
  715.         result = (*proc)(clientData, interp, buffer);
  716.         if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
  717.             || (ip.selPtr == NULL)) {
  718.             break;
  719.         }
  720.         offset += count;
  721.         }
  722.         pendingPtr = ip.nextPtr;
  723.     }
  724.     return result;
  725.     }
  726.  
  727.     /*
  728.      * The selection is owned by some other process.  To
  729.      * retrieve it, first record information about the retrieval
  730.      * in progress.  Use an internal window as the requestor.
  731.      */
  732.  
  733.     retr.interp = interp;
  734.     if (dispPtr->clipWindow == NULL) {
  735.     int result;
  736.  
  737.     result = TkClipInit(interp, dispPtr);
  738.     if (result != TCL_OK) {
  739.         return result;
  740.     }
  741.     }
  742.     retr.winPtr = (TkWindow *) dispPtr->clipWindow;
  743.     retr.selection = selection;
  744.     retr.property = selection;
  745.     retr.target = target;
  746.     retr.proc = proc;
  747.     retr.clientData = clientData;
  748.     retr.result = -1;
  749.     retr.idleTime = 0;
  750.     retr.nextPtr = pendingRetrievals;
  751.     pendingRetrievals = &retr;
  752.  
  753.     /*
  754.      * Initiate the request for the selection.  Note:  can't use
  755.      * TkCurrentTime for the time.  If we do, and this application hasn't
  756.      * received any X events in a long time, the current time will be way
  757.      * in the past and could even predate the time when the selection was
  758.      * made;  if this happens, the request will be rejected.
  759.      */
  760.  
  761.     XConvertSelection(winPtr->display, retr.selection, retr.target,
  762.         retr.property, retr.winPtr->window, CurrentTime);
  763.  
  764.     /*
  765.      * Enter a loop processing X events until the selection
  766.      * has been retrieved and processed.  If no response is
  767.      * received within a few seconds, then timeout.
  768.      */
  769.  
  770.     retr.timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
  771.         (ClientData) &retr);
  772.     while (retr.result == -1) {
  773.     Tk_DoOneEvent(0);
  774.     }
  775.     Tk_DeleteTimerHandler(retr.timeout);
  776.  
  777.     /*
  778.      * Unregister the information about the selection retrieval
  779.      * in progress.
  780.      */
  781.  
  782.     if (pendingRetrievals == &retr) {
  783.     pendingRetrievals = retr.nextPtr;
  784.     } else {
  785.     RetrievalInfo *retrPtr;
  786.  
  787.     for (retrPtr = pendingRetrievals; retrPtr != NULL;
  788.         retrPtr = retrPtr->nextPtr) {
  789.         if (retrPtr->nextPtr == &retr) {
  790.         retrPtr->nextPtr = retr.nextPtr;
  791.         break;
  792.         }
  793.     }
  794.     }
  795.     return retr.result;
  796.  
  797.     cantget:
  798.     Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
  799.     " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
  800.     "\" not defined", (char *) NULL);
  801.     return TCL_ERROR;
  802. }
  803.  
  804. /*
  805.  *--------------------------------------------------------------
  806.  *
  807.  * Tk_SelectionCmd --
  808.  *
  809.  *    This procedure is invoked to process the "selection" Tcl
  810.  *    command.  See the user documentation for details on what
  811.  *    it does.
  812.  *
  813.  * Results:
  814.  *    A standard Tcl result.
  815.  *
  816.  * Side effects:
  817.  *    See the user documentation.
  818.  *
  819.  *--------------------------------------------------------------
  820.  */
  821.  
  822. int
  823. Tk_SelectionCmd(clientData, interp, argc, argv)
  824.     ClientData clientData;    /* Main window associated with
  825.                  * interpreter. */
  826.     Tcl_Interp *interp;        /* Current interpreter. */
  827.     int argc;            /* Number of arguments. */
  828.     char **argv;        /* Argument strings. */
  829. {
  830.     Tk_Window tkwin = (Tk_Window) clientData;
  831.     char *path = NULL;
  832.     Atom selection;
  833.     char *selName = NULL;
  834.     int c, count;
  835.     size_t length;
  836.     char **args;
  837.  
  838.     if (argc < 2) {
  839.     sprintf(interp->result,
  840.         "wrong # args: should be \"%.50s option ?arg arg ...?\"",
  841.         argv[0]);
  842.     return TCL_ERROR;
  843.     }
  844.     c = argv[1][0];
  845.     length = strlen(argv[1]);
  846.     if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
  847.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  848.         if (args[0][0] != '-') {
  849.         break;
  850.         }
  851.         if (count < 2) {
  852.         Tcl_AppendResult(interp, "value for \"", *args,
  853.             "\" missing", (char *) NULL);
  854.         return TCL_ERROR;
  855.         }
  856.         c = args[0][1];
  857.         length = strlen(args[0]);
  858.         if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
  859.         path = args[1];
  860.         } else if ((c == 's')
  861.             && (strncmp(args[0], "-selection", length) == 0)) {
  862.         selName = args[1];
  863.         } else {
  864.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  865.             "\"", (char *) NULL);
  866.         return TCL_ERROR;
  867.         }
  868.     }
  869.     if (count == 1) {
  870.         path = args[0];
  871.     } else if (count > 1) {
  872.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  873.             " clear ?options?\"", (char *) NULL);
  874.         return TCL_ERROR;
  875.     }
  876.     if (path != NULL) {
  877.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  878.     }
  879.     if (tkwin == NULL) {
  880.         return TCL_ERROR;
  881.     }
  882.     if (selName != NULL) {
  883.         selection = Tk_InternAtom(tkwin, selName);
  884.     } else {
  885.         selection = XA_PRIMARY;
  886.     }
  887.         
  888.     Tk_ClearSelection(tkwin, selection);
  889.     return TCL_OK;
  890.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  891.     Atom target;
  892.     char *targetName = NULL;
  893.     Tcl_DString selBytes;
  894.     int result;
  895.     
  896.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  897.         if (args[0][0] != '-') {
  898.         break;
  899.         }
  900.         if (count < 2) {
  901.         Tcl_AppendResult(interp, "value for \"", *args,
  902.             "\" missing", (char *) NULL);
  903.         return TCL_ERROR;
  904.         }
  905.         c = args[0][1];
  906.         length = strlen(args[0]);
  907.         if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
  908.         path = args[1];
  909.         } else if ((c == 's')
  910.             && (strncmp(args[0], "-selection", length) == 0)) {
  911.         selName = args[1];
  912.         } else if ((c == 't')
  913.             && (strncmp(args[0], "-type", length) == 0)) {
  914.         targetName = args[1];
  915.         } else {
  916.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  917.             "\"", (char *) NULL);
  918.         return TCL_ERROR;
  919.         }
  920.     }
  921.     if (path != NULL) {
  922.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  923.     }
  924.     if (tkwin == NULL) {
  925.         return TCL_ERROR;
  926.     }
  927.     if (selName != NULL) {
  928.         selection = Tk_InternAtom(tkwin, selName);
  929.     } else {
  930.         selection = XA_PRIMARY;
  931.     }
  932.     if (count > 1) {
  933.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  934.             " get ?options?\"", (char *) NULL);
  935.         return TCL_ERROR;
  936.     } else if (count == 1) {
  937.         target = Tk_InternAtom(tkwin, args[0]);
  938.     } else if (targetName != NULL) {
  939.         target = Tk_InternAtom(tkwin, targetName);
  940.     } else {
  941.         target = XA_STRING;
  942.     }
  943.  
  944.     Tcl_DStringInit(&selBytes);
  945.     result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc,
  946.         (ClientData) &selBytes);
  947.     if (result == TCL_OK) {
  948.         Tcl_DStringResult(interp, &selBytes);
  949.     } else {
  950.         Tcl_DStringFree(&selBytes);
  951.     }
  952.     return result;
  953.     } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
  954.     Atom target, format;
  955.     char *targetName = NULL;
  956.     char *formatName = NULL;
  957.     register CommandInfo *cmdInfoPtr;
  958.     int cmdLength;
  959.     
  960.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  961.         if (args[0][0] != '-') {
  962.         break;
  963.         }
  964.         if (count < 2) {
  965.         Tcl_AppendResult(interp, "value for \"", *args,
  966.             "\" missing", (char *) NULL);
  967.         return TCL_ERROR;
  968.         }
  969.         c = args[0][1];
  970.         length = strlen(args[0]);
  971.         if ((c == 'f') && (strncmp(args[0], "-format", length) == 0)) {
  972.         formatName = args[1];
  973.         } else if ((c == 's')
  974.             && (strncmp(args[0], "-selection", length) == 0)) {
  975.         selName = args[1];
  976.         } else if ((c == 't')
  977.             && (strncmp(args[0], "-type", length) == 0)) {
  978.         targetName = args[1];
  979.         } else {
  980.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  981.             "\"", (char *) NULL);
  982.         return TCL_ERROR;
  983.         }
  984.     }
  985.  
  986.     if ((count < 2) || (count > 4)) {
  987.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  988.             " handle ?options? window command\"", (char *) NULL);
  989.         return TCL_ERROR;
  990.     }
  991.     tkwin = Tk_NameToWindow(interp, args[0], tkwin);
  992.     if (tkwin == NULL) {
  993.         return TCL_ERROR;
  994.     }
  995.     if (selName != NULL) {
  996.         selection = Tk_InternAtom(tkwin, selName);
  997.     } else {
  998.         selection = XA_PRIMARY;
  999.     }
  1000.         
  1001.     if (count > 2) {
  1002.         target = Tk_InternAtom(tkwin, args[2]);
  1003.     } else if (targetName != NULL) {
  1004.         target = Tk_InternAtom(tkwin, targetName);
  1005.     } else {
  1006.         target = XA_STRING;
  1007.     }
  1008.     if (count > 3) {
  1009.         format = Tk_InternAtom(tkwin, args[3]);
  1010.     } else if (formatName != NULL) {
  1011.         format = Tk_InternAtom(tkwin, formatName);
  1012.     } else {
  1013.         format = XA_STRING;
  1014.     }
  1015.     cmdLength = strlen(args[1]);
  1016.     if (cmdLength == 0) {
  1017.         Tk_DeleteSelHandler(tkwin, selection, target);
  1018.     } else {
  1019.         cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
  1020.             sizeof(CommandInfo) - 3 + cmdLength));
  1021.         cmdInfoPtr->interp = interp;
  1022.         cmdInfoPtr->cmdLength = cmdLength;
  1023.         strcpy(cmdInfoPtr->command, args[1]);
  1024.         Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
  1025.             (ClientData) cmdInfoPtr, format);
  1026.     }
  1027.     return TCL_OK;
  1028.     } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
  1029.     register LostCommand *lostPtr;
  1030.     char *script = NULL;
  1031.     int cmdLength;
  1032.  
  1033.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  1034.         if (args[0][0] != '-') {
  1035.         break;
  1036.         }
  1037.         if (count < 2) {
  1038.         Tcl_AppendResult(interp, "value for \"", *args,
  1039.             "\" missing", (char *) NULL);
  1040.         return TCL_ERROR;
  1041.         }
  1042.         c = args[0][1];
  1043.         length = strlen(args[0]);
  1044.         if ((c == 'c') && (strncmp(args[0], "-command", length) == 0)) {
  1045.         script = args[1];
  1046.         } else if ((c == 'd')
  1047.             && (strncmp(args[0], "-displayof", length) == 0)) {
  1048.         path = args[1];
  1049.         } else if ((c == 's')
  1050.             && (strncmp(args[0], "-selection", length) == 0)) {
  1051.         selName = args[1];
  1052.         } else {
  1053.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  1054.             "\"", (char *) NULL);
  1055.         return TCL_ERROR;
  1056.         }
  1057.     }
  1058.  
  1059.     if (count > 2) {
  1060.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1061.             " own ?options? ?window?\"", (char *) NULL);
  1062.         return TCL_ERROR;
  1063.     }
  1064.     if (selName != NULL) {
  1065.         selection = Tk_InternAtom(tkwin, selName);
  1066.     } else {
  1067.         selection = XA_PRIMARY;
  1068.     }
  1069.     if (count == 0) {
  1070.         TkSelectionInfo *infoPtr;
  1071.         TkWindow *winPtr;
  1072.         if (path != NULL) {
  1073.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  1074.         }
  1075.         if (tkwin == NULL) {
  1076.         return TCL_ERROR;
  1077.         }
  1078.         winPtr = (TkWindow *)tkwin;
  1079.         for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
  1080.             infoPtr = infoPtr->nextPtr) {
  1081.         if (infoPtr->selection == selection)
  1082.             break;
  1083.         }
  1084.  
  1085.         /*
  1086.          * Ignore the internal clipboard window.
  1087.          */
  1088.  
  1089.         if ((infoPtr != NULL)
  1090.             && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
  1091.         interp->result = Tk_PathName(infoPtr->owner);
  1092.         }
  1093.         return TCL_OK;
  1094.     }
  1095.     tkwin = Tk_NameToWindow(interp, args[0], tkwin);
  1096.     if (tkwin == NULL) {
  1097.         return TCL_ERROR;
  1098.     }
  1099.     if (count == 2) {
  1100.         script = args[1];
  1101.     }
  1102.     if (script == NULL) {
  1103.         Tk_OwnSelection(tkwin, selection, (Tk_LostSelProc *) NULL,
  1104.             (ClientData) NULL);
  1105.         return TCL_OK;
  1106.     }
  1107.     cmdLength = strlen(script);
  1108.     lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
  1109.         -3 + cmdLength));
  1110.     lostPtr->interp = interp;
  1111.     strcpy(lostPtr->command, script);
  1112.     Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
  1113.     return TCL_OK;
  1114.     } else {
  1115.     sprintf(interp->result,
  1116.         "bad option \"%.50s\":  must be clear, get, handle, or own",
  1117.         argv[1]);
  1118.     return TCL_ERROR;
  1119.     }
  1120. }
  1121.  
  1122. /*
  1123.  *----------------------------------------------------------------------
  1124.  *
  1125.  * TkSelDeadWindow --
  1126.  *
  1127.  *    This procedure is invoked just before a TkWindow is deleted.
  1128.  *    It performs selection-related cleanup.
  1129.  *
  1130.  * Results:
  1131.  *    None.
  1132.  *
  1133.  * Side effects:
  1134.  *    Frees up memory associated with the selection.
  1135.  *
  1136.  *----------------------------------------------------------------------
  1137.  */
  1138.  
  1139. void
  1140. TkSelDeadWindow(winPtr)
  1141.     register TkWindow *winPtr;    /* Window that's being deleted. */
  1142. {
  1143.     register TkSelHandler *selPtr;
  1144.     register InProgress *ipPtr;
  1145.     TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
  1146.  
  1147.     /*
  1148.      * While deleting all the handlers, be careful to check whether
  1149.      * ConvertSelection or TkSelPropProc are about to process one of the
  1150.      * deleted handlers.
  1151.      */
  1152.  
  1153.     while (winPtr->selHandlerList != NULL) {
  1154.     selPtr = winPtr->selHandlerList;
  1155.     winPtr->selHandlerList = selPtr->nextPtr;
  1156.     for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
  1157.         if (ipPtr->selPtr == selPtr) {
  1158.         ipPtr->selPtr = NULL;
  1159.         }
  1160.     }
  1161.     if (selPtr->proc == HandleTclCommand) {
  1162.         ckfree((char *) selPtr->clientData);
  1163.     }
  1164.     ckfree((char *) selPtr);
  1165.     }
  1166.  
  1167.     /*
  1168.      * Remove selections owned by window being deleted.
  1169.      */
  1170.  
  1171.     for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
  1172.          infoPtr != NULL; infoPtr = nextPtr) {
  1173.     nextPtr = infoPtr->nextPtr;
  1174.     if (infoPtr->owner == (Tk_Window) winPtr) {
  1175.         if (infoPtr->clearProc == LostSelection) {
  1176.         ckfree((char *) infoPtr->clearData);
  1177.         }
  1178.         ckfree((char *) infoPtr);
  1179.         infoPtr = prevPtr;
  1180.         if (prevPtr == NULL) {
  1181.         winPtr->dispPtr->selectionInfoPtr = nextPtr;
  1182.         } else {
  1183.         prevPtr->nextPtr = nextPtr;
  1184.         }
  1185.     }
  1186.     prevPtr = infoPtr;
  1187.     }
  1188. }
  1189.  
  1190. /*
  1191.  *----------------------------------------------------------------------
  1192.  *
  1193.  * TkSelInit --
  1194.  *
  1195.  *    Initialize selection-related information for a display.
  1196.  *
  1197.  * Results:
  1198.  *    None.
  1199.  *
  1200.  * Side effects:
  1201.  *    Selection-related information is initialized.
  1202.  *
  1203.  *----------------------------------------------------------------------
  1204.  */
  1205.  
  1206. void
  1207. TkSelInit(tkwin)
  1208.     Tk_Window tkwin;        /* Window token (used to find
  1209.                  * display to initialize). */
  1210. {
  1211.     register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  1212.  
  1213.     /*
  1214.      * Fetch commonly-used atoms.
  1215.      */
  1216.  
  1217.     dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
  1218.     dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
  1219.     dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
  1220.     dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
  1221.     dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
  1222.     dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
  1223.     dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
  1224.     dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
  1225.     dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
  1226. }
  1227.  
  1228. /*
  1229.  *--------------------------------------------------------------
  1230.  *
  1231.  * TkSelEventProc --
  1232.  *
  1233.  *    This procedure is invoked whenever a selection-related
  1234.  *    event occurs.  It does the lion's share of the work
  1235.  *    in implementing the selection protocol.
  1236.  *
  1237.  * Results:
  1238.  *    None.
  1239.  *
  1240.  * Side effects:
  1241.  *    Lots:  depends on the type of event.
  1242.  *
  1243.  *--------------------------------------------------------------
  1244.  */
  1245.  
  1246. void
  1247. TkSelEventProc(tkwin, eventPtr)
  1248.     Tk_Window tkwin;        /* Window for which event was
  1249.                  * targeted. */
  1250.     register XEvent *eventPtr;    /* X event:  either SelectionClear,
  1251.                  * SelectionRequest, or
  1252.                  * SelectionNotify. */
  1253. {
  1254.     register TkWindow *winPtr = (TkWindow *) tkwin;
  1255.     TkDisplay *dispPtr = winPtr->dispPtr;
  1256.  
  1257.     /*
  1258.      * Case #1: SelectionClear events.  Invoke clear procedure
  1259.      * for window that just lost the selection.  This code is a
  1260.      * bit tricky, because any callbacks due to selection changes
  1261.      * between windows managed by the process have already been
  1262.      * made.  Thus, ignore the event unless it refers to the
  1263.      * window that's currently the selection owner and the event
  1264.      * was generated after the server saw the SetSelectionOwner
  1265.      * request.
  1266.      */
  1267.  
  1268.     if (eventPtr->type == SelectionClear) {
  1269.     TkSelectionInfo *infoPtr;
  1270.     TkSelectionInfo *prevPtr;
  1271.     for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
  1272.         infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  1273.         if (infoPtr->selection == eventPtr->xselectionclear.selection) {
  1274.         break;
  1275.         }
  1276.         prevPtr = infoPtr;
  1277.     }
  1278.  
  1279.     if (infoPtr != NULL && (infoPtr->owner == tkwin)
  1280.         && (eventPtr->xselectionclear.serial >= infoPtr->serial)) {
  1281.         if (prevPtr == NULL) {
  1282.         dispPtr->selectionInfoPtr = infoPtr->nextPtr;
  1283.         } else {
  1284.         prevPtr->nextPtr = infoPtr->nextPtr;
  1285.         }
  1286.  
  1287.         /*
  1288.          * Because of reentrancy problems, calling clearProc must be done
  1289.          * after the infoPtr has been removed from the selectionInfoPtr
  1290.          * list (clearProc could modify the list, e.g. by creating
  1291.          * a new selection).
  1292.          */
  1293.  
  1294.         if (infoPtr->clearProc != NULL) {
  1295.         (*infoPtr->clearProc)(infoPtr->clearData);
  1296.         }
  1297.         ckfree((char *) infoPtr);
  1298.     }
  1299.     return;
  1300.     }
  1301.  
  1302.     /*
  1303.      * Case #2: SelectionNotify events.  Call the relevant procedure
  1304.      * to handle the incoming selection.
  1305.      */
  1306.  
  1307.     if (eventPtr->type == SelectionNotify) {
  1308.     register RetrievalInfo *retrPtr;
  1309.     char *propInfo;
  1310.     Atom type;
  1311.     int format, result;
  1312.     unsigned long numItems, bytesAfter;
  1313.  
  1314.     for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
  1315.         if (retrPtr == NULL) {
  1316.         return;
  1317.         }
  1318.         if ((retrPtr->winPtr == winPtr)
  1319.             && (retrPtr->selection == eventPtr->xselection.selection)
  1320.             && (retrPtr->target == eventPtr->xselection.target)
  1321.             && (retrPtr->result == -1)) {
  1322.         if (retrPtr->property == eventPtr->xselection.property) {
  1323.             break;
  1324.         }
  1325.         if (eventPtr->xselection.property == None) {
  1326.             Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  1327.             Tcl_AppendResult(retrPtr->interp,
  1328.                 Tk_GetAtomName(tkwin, retrPtr->selection),
  1329.                 " selection doesn't exist or form \"",
  1330.                 Tk_GetAtomName(tkwin, retrPtr->target),
  1331.                 "\" not defined", (char *) NULL);
  1332.             retrPtr->result = TCL_ERROR;
  1333.             return;
  1334.         }
  1335.         }
  1336.     }
  1337.  
  1338.     propInfo = NULL;
  1339.     result = XGetWindowProperty(eventPtr->xselection.display,
  1340.         eventPtr->xselection.requestor, retrPtr->property,
  1341.         0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
  1342.         &type, &format, &numItems, &bytesAfter,
  1343.         (unsigned char **) &propInfo);
  1344.     if ((result != Success) || (type == None)) {
  1345.         return;
  1346.     }
  1347.     if (bytesAfter != 0) {
  1348.         Tcl_SetResult(retrPtr->interp, "selection property too large",
  1349.         TCL_STATIC);
  1350.         retrPtr->result = TCL_ERROR;
  1351.         XFree(propInfo);
  1352.         return;
  1353.     }
  1354.     if ((type == XA_STRING) || (type == dispPtr->textAtom)
  1355.         || (type == dispPtr->compoundTextAtom)) {
  1356.         if (format != 8) {
  1357.         sprintf(retrPtr->interp->result,
  1358.             "bad format for string selection: wanted \"8\", got \"%d\"",
  1359.             format);
  1360.         retrPtr->result = TCL_ERROR;
  1361.         return;
  1362.         }
  1363.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  1364.             retrPtr->interp, propInfo);
  1365.     } else if (type == dispPtr->incrAtom) {
  1366.  
  1367.         /*
  1368.          * It's a !?#@!?!! INCR-style reception.  Arrange to receive
  1369.          * the selection in pieces, using the ICCCM protocol, then
  1370.          * hang around until either the selection is all here or a
  1371.          * timeout occurs.
  1372.          */
  1373.  
  1374.         retrPtr->idleTime = 0;
  1375.         Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  1376.             (ClientData) retrPtr);
  1377.         XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
  1378.             retrPtr->property);
  1379.         while (retrPtr->result == -1) {
  1380.         Tk_DoOneEvent(0);
  1381.         }
  1382.         Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  1383.             (ClientData) retrPtr);
  1384.     } else {
  1385.         char *string;
  1386.  
  1387.         if (format != 32) {
  1388.         sprintf(retrPtr->interp->result,
  1389.             "bad format for selection: wanted \"32\", got \"%d\"",
  1390.             format);
  1391.         retrPtr->result = TCL_ERROR;
  1392.         return;
  1393.         }
  1394.         string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  1395.             (Tk_Window) winPtr);
  1396.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  1397.             retrPtr->interp, string);
  1398.         ckfree(string);
  1399.     }
  1400.     XFree(propInfo);
  1401.     return;
  1402.     }
  1403.  
  1404.     /*
  1405.      * Case #3: SelectionRequest events.  Call ConvertSelection to
  1406.      * do the dirty work.
  1407.      */
  1408.  
  1409.     if (eventPtr->type == SelectionRequest) {
  1410.     ConvertSelection(winPtr, &eventPtr->xselectionrequest);
  1411.     return;
  1412.     }
  1413. }
  1414.  
  1415. /*
  1416.  *--------------------------------------------------------------
  1417.  *
  1418.  * SelGetProc --
  1419.  *
  1420.  *    This procedure is invoked to process pieces of the selection
  1421.  *    as they arrive during "selection get" commands.
  1422.  *
  1423.  * Results:
  1424.  *    Always returns TCL_OK.
  1425.  *
  1426.  * Side effects:
  1427.  *    Bytes get appended to the dynamic string pointed to by the
  1428.  *    clientData argument.
  1429.  *
  1430.  *--------------------------------------------------------------
  1431.  */
  1432.  
  1433.     /* ARGSUSED */
  1434. static int
  1435. SelGetProc(clientData, interp, portion)
  1436.     ClientData clientData;    /* Dynamic string holding partially
  1437.                  * assembled selection. */
  1438.     Tcl_Interp *interp;        /* Interpreter used for error
  1439.                  * reporting (not used). */
  1440.     char *portion;        /* New information to be appended. */
  1441. {
  1442.     Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
  1443.     return TCL_OK;
  1444. }
  1445.  
  1446. /*
  1447.  *----------------------------------------------------------------------
  1448.  *
  1449.  * SelCvtToX --
  1450.  *
  1451.  *    Given a selection represented as a string (the normal Tcl form),
  1452.  *    convert it to the ICCCM-mandated format for X, depending on
  1453.  *    the type argument.  This procedure and SelCvtFromX are inverses.
  1454.  *
  1455.  * Results:
  1456.  *    The return value is a malloc'ed buffer holding a value
  1457.  *    equivalent to "string", but formatted as for "type".  It is
  1458.  *    the caller's responsibility to free the string when done with
  1459.  *    it.  The word at *numLongsPtr is filled in with the number of
  1460.  *    32-bit words returned in the result.
  1461.  *
  1462.  * Side effects:
  1463.  *    None.
  1464.  *
  1465.  *----------------------------------------------------------------------
  1466.  */
  1467.  
  1468. static long *
  1469. SelCvtToX(string, type, tkwin, numLongsPtr)
  1470.     char *string;        /* String representation of selection. */
  1471.     Atom type;            /* Atom specifying the X format that is
  1472.                  * desired for the selection.  Should not
  1473.                  * be XA_STRING (if so, don't bother calling
  1474.                  * this procedure at all). */
  1475.     Tk_Window tkwin;        /* Window that governs atom conversion. */
  1476.     int *numLongsPtr;        /* Number of 32-bit words contained in the
  1477.                  * result. */
  1478. {
  1479.     register char *p;
  1480.     char *field;
  1481.     int numFields;
  1482.     long *propPtr, *longPtr;
  1483. #define MAX_ATOM_NAME_LENGTH 100
  1484.     char atomName[MAX_ATOM_NAME_LENGTH+1];
  1485.  
  1486.     /*
  1487.      * The string is assumed to consist of fields separated by spaces.
  1488.      * The property gets generated by converting each field to an
  1489.      * integer number, in one of two ways:
  1490.      * 1. If type is XA_ATOM, convert each field to its corresponding
  1491.      *      atom.
  1492.      * 2. If type is anything else, convert each field from an ASCII number
  1493.      *    to a 32-bit binary number.
  1494.      */
  1495.  
  1496.     numFields = 1;
  1497.     for (p = string; *p != 0; p++) {
  1498.     if (isspace(UCHAR(*p))) {
  1499.         numFields++;
  1500.     }
  1501.     }
  1502.     propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
  1503.  
  1504.     /*
  1505.      * Convert the fields one-by-one.
  1506.      */
  1507.  
  1508.     for (longPtr = propPtr, *numLongsPtr = 0, p = string;
  1509.         ; longPtr++, (*numLongsPtr)++) {
  1510.     while (isspace(UCHAR(*p))) {
  1511.         p++;
  1512.     }
  1513.     if (*p == 0) {
  1514.         break;
  1515.     }
  1516.     field = p;
  1517.     while ((*p != 0) && !isspace(UCHAR(*p))) {
  1518.         p++;
  1519.     }
  1520.     if (type == XA_ATOM) {
  1521.         int length;
  1522.  
  1523.         length = p - field;
  1524.         if (length > MAX_ATOM_NAME_LENGTH) {
  1525.         length = MAX_ATOM_NAME_LENGTH;
  1526.         }
  1527.         strncpy(atomName, field, (unsigned) length);
  1528.         atomName[length] = 0;
  1529.         *longPtr = (long) Tk_InternAtom(tkwin, atomName);
  1530.     } else {
  1531.         char *dummy;
  1532.  
  1533.         *longPtr = strtol(field, &dummy, 0);
  1534.     }
  1535.     }
  1536.     return propPtr;
  1537. }
  1538.  
  1539. /*
  1540.  *----------------------------------------------------------------------
  1541.  *
  1542.  * SelCvtFromX --
  1543.  *
  1544.  *    Given an X property value, formatted as a collection of 32-bit
  1545.  *    values according to "type" and the ICCCM conventions, convert
  1546.  *    the value to a string suitable for manipulation by Tcl.  This
  1547.  *    procedure is the inverse of SelCvtToX.
  1548.  *
  1549.  * Results:
  1550.  *    The return value is the string equivalent of "property".  It is
  1551.  *    malloc-ed and should be freed by the caller when no longer
  1552.  *    needed.
  1553.  *
  1554.  * Side effects:
  1555.  *    None.
  1556.  *
  1557.  *----------------------------------------------------------------------
  1558.  */
  1559.  
  1560. static char *
  1561. SelCvtFromX(propPtr, numValues, type, tkwin)
  1562.     register long *propPtr;    /* Property value from X. */
  1563.     int numValues;        /* Number of 32-bit values in property. */
  1564.     Atom type;            /* Type of property  Should not be
  1565.                  * XA_STRING (if so, don't bother calling
  1566.                  * this procedure at all). */
  1567.     Tk_Window tkwin;        /* Window to use for atom conversion. */
  1568. {
  1569.     char *result;
  1570.     int resultSpace, curSize, fieldSize;
  1571.     char *atomName;
  1572.  
  1573.     /*
  1574.      * Convert each long in the property to a string value, which is
  1575.      * either the name of an atom (if type is XA_ATOM) or a hexadecimal
  1576.      * string.  Make an initial guess about the size of the result, but
  1577.      * be prepared to enlarge the result if necessary.
  1578.      */
  1579.  
  1580.     resultSpace = 12*numValues+1;
  1581.     curSize = 0;
  1582.     atomName = "";    /* Not needed, but eliminates compiler warning. */
  1583.     result = (char *) ckalloc((unsigned) resultSpace);
  1584.     *result  = '\0';
  1585.     for ( ; numValues > 0; propPtr++, numValues--) {
  1586.     if (type == XA_ATOM) {
  1587.         atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
  1588.         fieldSize = strlen(atomName) + 1;
  1589.     } else {
  1590.         fieldSize = 12;
  1591.     }
  1592.     if (curSize+fieldSize >= resultSpace) {
  1593.         char *newResult;
  1594.  
  1595.         resultSpace *= 2;
  1596.         if (curSize+fieldSize >= resultSpace) {
  1597.         resultSpace = curSize + fieldSize + 1;
  1598.         }
  1599.         newResult = (char *) ckalloc((unsigned) resultSpace);
  1600.         strncpy(newResult, result, (unsigned) curSize);
  1601.         ckfree(result);
  1602.         result = newResult;
  1603.     }
  1604.     if (curSize != 0) {
  1605.         result[curSize] = ' ';
  1606.         curSize++;
  1607.     }
  1608.     if (type == XA_ATOM) {
  1609.         strcpy(result+curSize, atomName);
  1610.     } else {
  1611.         sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
  1612.     }
  1613.     curSize += strlen(result+curSize);
  1614.     }
  1615.     return result;
  1616. }
  1617.  
  1618. /*
  1619.  *----------------------------------------------------------------------
  1620.  *
  1621.  * ConvertSelection --
  1622.  *
  1623.  *    This procedure is invoked to handle SelectionRequest events.
  1624.  *    It responds to the requests, obeying the ICCCM protocols.
  1625.  *
  1626.  * Results:
  1627.  *    None.
  1628.  *
  1629.  * Side effects:
  1630.  *    Properties are created for the selection requestor, and a
  1631.  *    SelectionNotify event is generated for the selection
  1632.  *    requestor.  In the event of long selections, this procedure
  1633.  *    implements INCR-mode transfers, using the ICCCM protocol.
  1634.  *
  1635.  *----------------------------------------------------------------------
  1636.  */
  1637.  
  1638. static void
  1639. ConvertSelection(winPtr, eventPtr)
  1640.     TkWindow *winPtr;            /* Window that received the
  1641.                      * conversion request;  may not be
  1642.                      * selection's current owner, be we
  1643.                      * set it to the current owner. */
  1644.     register XSelectionRequestEvent *eventPtr;
  1645.                     /* Event describing request. */
  1646. {
  1647.     XSelectionEvent reply;        /* Used to notify requestor that
  1648.                      * selection info is ready. */
  1649.     int multiple;            /* Non-zero means a MULTIPLE request
  1650.                      * is being handled. */
  1651.     IncrInfo incr;            /* State of selection conversion. */
  1652.     Atom singleInfo[2];            /* incr.multAtoms points here except
  1653.                      * for multiple conversions. */
  1654.     int i;
  1655.     Tk_ErrorHandler errorHandler;
  1656.     TkSelectionInfo *infoPtr;
  1657.     InProgress ip;
  1658.  
  1659.     errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
  1660.         (int (*)()) NULL, (ClientData) NULL);
  1661.  
  1662.     /*
  1663.      * Initialize the reply event.
  1664.      */
  1665.  
  1666.     reply.type = SelectionNotify;
  1667.     reply.serial = 0;
  1668.     reply.send_event = True;
  1669.     reply.display = eventPtr->display;
  1670.     reply.requestor = eventPtr->requestor;
  1671.     reply.selection = eventPtr->selection;
  1672.     reply.target = eventPtr->target;
  1673.     reply.property = eventPtr->property;
  1674.     if (reply.property == None) {
  1675.     reply.property = reply.target;
  1676.     }
  1677.     reply.time = eventPtr->time;
  1678.  
  1679.     for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
  1680.         infoPtr = infoPtr->nextPtr) {
  1681.     if (infoPtr->selection == eventPtr->selection)
  1682.         break;
  1683.     }
  1684.     if (infoPtr == NULL) {
  1685.     goto refuse;
  1686.     }
  1687.     winPtr = (TkWindow *) infoPtr->owner;
  1688.  
  1689.     /*
  1690.      * Figure out which kind(s) of conversion to perform.  If handling
  1691.      * a MULTIPLE conversion, then read the property describing which
  1692.      * conversions to perform.
  1693.      */
  1694.  
  1695.     incr.winPtr = winPtr;
  1696.     incr.selection = eventPtr->selection;
  1697.     if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
  1698.     multiple = 0;
  1699.     singleInfo[0] = reply.target;
  1700.     singleInfo[1] = reply.property;
  1701.     incr.multAtoms = singleInfo;
  1702.     incr.numConversions = 1;
  1703.     } else {
  1704.     Atom type;
  1705.     int format, result;
  1706.     unsigned long bytesAfter;
  1707.  
  1708.     multiple = 1;
  1709.     incr.multAtoms = NULL;
  1710.     if (eventPtr->property == None) {
  1711.         goto refuse;
  1712.     }
  1713.     result = XGetWindowProperty(eventPtr->display,
  1714.         eventPtr->requestor, eventPtr->property,
  1715.         0, MAX_PROP_WORDS, False, XA_ATOM,
  1716.         &type, &format, &incr.numConversions, &bytesAfter,
  1717.         (unsigned char **) &incr.multAtoms);
  1718.     if ((result != Success) || (bytesAfter != 0) || (format != 32)
  1719.         || (type == None)) {
  1720.         if (incr.multAtoms != NULL) {
  1721.         XFree((char *) incr.multAtoms);
  1722.         }
  1723.         goto refuse;
  1724.     }
  1725.     incr.numConversions /= 2;        /* Two atoms per conversion. */
  1726.     }
  1727.  
  1728.     /*
  1729.      * Loop through all of the requested conversions, and either return
  1730.      * the entire converted selection, if it can be returned in a single
  1731.      * bunch, or return INCR information only (the actual selection will
  1732.      * be returned below).
  1733.      */
  1734.  
  1735.     incr.offsets = (int *) ckalloc((unsigned)
  1736.         (incr.numConversions*sizeof(int)));
  1737.     incr.numIncrs = 0;
  1738.     for (i = 0; i < incr.numConversions; i++) {
  1739.     Atom target, property, type;
  1740.     long buffer[TK_SEL_WORDS_AT_ONCE];
  1741.     register TkSelHandler *selPtr;
  1742.     int numItems, format;
  1743.     char *propPtr;
  1744.  
  1745.     target = incr.multAtoms[2*i];
  1746.     property = incr.multAtoms[2*i + 1];
  1747.     incr.offsets[i] = -1;
  1748.  
  1749.     for (selPtr = winPtr->selHandlerList; selPtr != NULL;
  1750.         selPtr = selPtr->nextPtr) {
  1751.         if ((selPtr->target == target)
  1752.             && (selPtr->selection == eventPtr->selection)) {
  1753.         break;
  1754.         }
  1755.     }
  1756.  
  1757.     if (selPtr == NULL) {
  1758.         /*
  1759.          * Nobody seems to know about this kind of request.  If
  1760.          * it's of a sort that we can handle without any help, do
  1761.          * it.  Otherwise mark the request as an errror.
  1762.          */
  1763.  
  1764.         numItems = DefaultSelection(infoPtr, target, (char *) buffer,
  1765.             TK_SEL_BYTES_AT_ONCE, &type);
  1766.         if (numItems < 0) {
  1767.         incr.multAtoms[2*i + 1] = None;
  1768.         continue;
  1769.         }
  1770.     } else {
  1771.         ip.selPtr = selPtr;
  1772.         ip.nextPtr = pendingPtr;
  1773.         pendingPtr = &ip;
  1774.         type = selPtr->format;
  1775.         numItems = (*selPtr->proc)(selPtr->clientData, 0,
  1776.             (char *) buffer, TK_SEL_BYTES_AT_ONCE);
  1777.         pendingPtr = ip.nextPtr;
  1778.         if ((ip.selPtr == NULL) || (numItems < 0)) {
  1779.         incr.multAtoms[2*i + 1] = None;
  1780.         continue;
  1781.         }
  1782.         if (numItems > TK_SEL_BYTES_AT_ONCE) {
  1783.         panic("selection handler returned too many bytes");
  1784.         }
  1785.         ((char *) buffer)[numItems] = '\0';
  1786.     }
  1787.  
  1788.     /*
  1789.      * Got the selection;  store it back on the requestor's property.
  1790.      */
  1791.  
  1792.     if (numItems == TK_SEL_BYTES_AT_ONCE) {
  1793.         /*
  1794.          * Selection is too big to send at once;  start an
  1795.          * INCR-mode transfer.
  1796.          */
  1797.  
  1798.         incr.numIncrs++;
  1799.         type = winPtr->dispPtr->incrAtom;
  1800.         buffer[0] = SelectionSize(selPtr);
  1801.         if (buffer[0] == 0) {
  1802.         incr.multAtoms[2*i + 1] = None;
  1803.         continue;
  1804.         }
  1805.         numItems = 1;
  1806.         propPtr = (char *) buffer;
  1807.         format = 32;
  1808.         incr.offsets[i] = 0;
  1809.     } else if (type == XA_STRING) {
  1810.         propPtr = (char *) buffer;
  1811.         format = 8;
  1812.     } else {
  1813.         propPtr = (char *) SelCvtToX((char *) buffer,
  1814.             type, (Tk_Window) winPtr, &numItems);
  1815.         format = 32;
  1816.     }
  1817.     XChangeProperty(reply.display, reply.requestor,
  1818.         property, type, format, PropModeReplace,
  1819.         (unsigned char *) propPtr, numItems);
  1820.     if (propPtr != (char *) buffer) {
  1821.         ckfree(propPtr);
  1822.     }
  1823.     }
  1824.  
  1825.     /*
  1826.      * Send an event back to the requestor to indicate that the
  1827.      * first stage of conversion is complete (everything is done
  1828.      * except for long conversions that have to be done in INCR
  1829.      * mode).
  1830.      */
  1831.  
  1832.     if (incr.numIncrs > 0) {
  1833.     XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
  1834.     incr.timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
  1835.         (ClientData) &incr);
  1836.     incr.idleTime = 0;
  1837.     incr.reqWindow = reply.requestor;
  1838.     incr.time = infoPtr->time;
  1839.     incr.nextPtr = pendingIncrs;
  1840.     pendingIncrs = &incr;
  1841.     }
  1842.     if (multiple) {
  1843.     XChangeProperty(reply.display, reply.requestor, reply.property,
  1844.         XA_ATOM, 32, PropModeReplace,
  1845.         (unsigned char *) incr.multAtoms,
  1846.         (int) incr.numConversions*2);
  1847.     } else {
  1848.  
  1849.     /*
  1850.      * Not a MULTIPLE request.  The first property in "multAtoms"
  1851.      * got set to None if there was an error in conversion.
  1852.      */
  1853.  
  1854.     reply.property = incr.multAtoms[1];
  1855.     }
  1856.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  1857.     Tk_DeleteErrorHandler(errorHandler);
  1858.  
  1859.     /*
  1860.      * Handle any remaining INCR-mode transfers.  This all happens
  1861.      * in callbacks to TkSelPropProc, so just wait until the number
  1862.      * of uncompleted INCR transfers drops to zero.
  1863.      */
  1864.  
  1865.     if (incr.numIncrs > 0) {
  1866.     IncrInfo *incrPtr2;
  1867.  
  1868.     while (incr.numIncrs > 0) {
  1869.         Tk_DoOneEvent(0);
  1870.     }
  1871.     Tk_DeleteTimerHandler(incr.timeout);
  1872.     errorHandler = Tk_CreateErrorHandler(winPtr->display,
  1873.         -1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
  1874.     XSelectInput(reply.display, reply.requestor, 0L);
  1875.     Tk_DeleteErrorHandler(errorHandler);
  1876.     if (pendingIncrs == &incr) {
  1877.         pendingIncrs = incr.nextPtr;
  1878.     } else {
  1879.         for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
  1880.             incrPtr2 = incrPtr2->nextPtr) {
  1881.         if (incrPtr2->nextPtr == &incr) {
  1882.             incrPtr2->nextPtr = incr.nextPtr;
  1883.             break;
  1884.         }
  1885.         }
  1886.     }
  1887.     }
  1888.  
  1889.     /*
  1890.      * All done.  Cleanup and return.
  1891.      */
  1892.  
  1893.     ckfree((char *) incr.offsets);
  1894.     if (multiple) {
  1895.     XFree((char *) incr.multAtoms);
  1896.     }
  1897.     return;
  1898.  
  1899.     /*
  1900.      * An error occurred.  Send back a refusal message.
  1901.      */
  1902.  
  1903.     refuse:
  1904.     reply.property = None;
  1905.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  1906.     Tk_DeleteErrorHandler(errorHandler);
  1907.     return;
  1908. }
  1909.  
  1910. /*
  1911.  *----------------------------------------------------------------------
  1912.  *
  1913.  * SelRcvIncrProc --
  1914.  *
  1915.  *    This procedure handles the INCR protocol on the receiving
  1916.  *    side.  It is invoked in response to property changes on
  1917.  *    the requestor's window (which hopefully are because a new
  1918.  *    chunk of the selection arrived).
  1919.  *
  1920.  * Results:
  1921.  *    None.
  1922.  *
  1923.  * Side effects:
  1924.  *    If a new piece of selection has arrived, a procedure is
  1925.  *    invoked to deal with that piece.  When the whole selection
  1926.  *    is here, a flag is left for the higher-level procedure that
  1927.  *    initiated the selection retrieval.
  1928.  *
  1929.  *----------------------------------------------------------------------
  1930.  */
  1931.  
  1932. static void
  1933. SelRcvIncrProc(clientData, eventPtr)
  1934.     ClientData clientData;        /* Information about retrieval. */
  1935.     register XEvent *eventPtr;        /* X PropertyChange event. */
  1936. {
  1937.     register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
  1938.     char *propInfo;
  1939.     Atom type;
  1940.     int format, result;
  1941.     unsigned long numItems, bytesAfter;
  1942.  
  1943.     if ((eventPtr->xproperty.atom != retrPtr->property)
  1944.         || (eventPtr->xproperty.state != PropertyNewValue)
  1945.         || (retrPtr->result != -1)) {
  1946.     return;
  1947.     }
  1948.     propInfo = NULL;
  1949.     result = XGetWindowProperty(eventPtr->xproperty.display,
  1950.         eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
  1951.         True, (Atom) AnyPropertyType, &type, &format, &numItems,
  1952.         &bytesAfter, (unsigned char **) &propInfo);
  1953.     if ((result != Success) || (type == None)) {
  1954.     return;
  1955.     }
  1956.     if (bytesAfter != 0) {
  1957.     Tcl_SetResult(retrPtr->interp, "selection property too large",
  1958.         TCL_STATIC);
  1959.     retrPtr->result = TCL_ERROR;
  1960.     goto done;
  1961.     }
  1962.     if (numItems == 0) {
  1963.     retrPtr->result = TCL_OK;
  1964.     } else if ((type == XA_STRING)
  1965.         || (type == retrPtr->winPtr->dispPtr->textAtom)
  1966.         || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
  1967.     if (format != 8) {
  1968.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  1969.         sprintf(retrPtr->interp->result,
  1970.         "bad format for string selection: wanted \"8\", got \"%d\"",
  1971.         format);
  1972.         retrPtr->result = TCL_ERROR;
  1973.         goto done;
  1974.     }
  1975.     result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
  1976.         propInfo);
  1977.     if (result != TCL_OK) {
  1978.         retrPtr->result = result;
  1979.     }
  1980.     } else {
  1981.     char *string;
  1982.  
  1983.     if (format != 32) {
  1984.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  1985.         sprintf(retrPtr->interp->result,
  1986.         "bad format for selection: wanted \"32\", got \"%d\"",
  1987.         format);
  1988.         retrPtr->result = TCL_ERROR;
  1989.         goto done;
  1990.     }
  1991.     string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  1992.         (Tk_Window) retrPtr->winPtr);
  1993.     result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
  1994.         string);
  1995.     if (result != TCL_OK) {
  1996.         retrPtr->result = result;
  1997.     }
  1998.     ckfree(string);
  1999.     }
  2000.  
  2001.     done:
  2002.     XFree(propInfo);
  2003.     retrPtr->idleTime = 0;
  2004. }
  2005.  
  2006. /*
  2007.  *----------------------------------------------------------------------
  2008.  *
  2009.  * TkSelPropProc --
  2010.  *
  2011.  *    This procedure is invoked when property-change events
  2012.  *    occur on windows not known to the toolkit.  Its function
  2013.  *    is to implement the sending side of the INCR selection
  2014.  *    retrieval protocol when the selection requestor deletes
  2015.  *    the property containing a part of the selection.
  2016.  *
  2017.  * Results:
  2018.  *    None.
  2019.  *
  2020.  * Side effects:
  2021.  *    If the property that is receiving the selection was just
  2022.  *    deleted, then a new piece of the selection is fetched and
  2023.  *    placed in the property, until eventually there's no more
  2024.  *    selection to fetch.
  2025.  *
  2026.  *----------------------------------------------------------------------
  2027.  */
  2028.  
  2029. void
  2030. TkSelPropProc(eventPtr)
  2031.     register XEvent *eventPtr;        /* X PropertyChange event. */
  2032. {
  2033.     register IncrInfo *incrPtr;
  2034.     int i, format;
  2035.     Atom target, formatType;
  2036.     register TkSelHandler *selPtr;
  2037.     long buffer[TK_SEL_WORDS_AT_ONCE];
  2038.     int numItems;
  2039.     char *propPtr;
  2040.     Tk_ErrorHandler errorHandler;
  2041.  
  2042.     /*
  2043.      * See if this event announces the deletion of a property being
  2044.      * used for an INCR transfer.  If so, then add the next chunk of
  2045.      * data to the property.
  2046.      */
  2047.  
  2048.     if (eventPtr->xproperty.state != PropertyDelete) {
  2049.     return;
  2050.     }
  2051.     for (incrPtr = pendingIncrs; incrPtr != NULL;
  2052.         incrPtr = incrPtr->nextPtr) {
  2053.     if (incrPtr->reqWindow != eventPtr->xproperty.window) {
  2054.         continue;
  2055.     }
  2056.     for (i = 0; i < incrPtr->numConversions; i++) {
  2057.         if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
  2058.             || (incrPtr->offsets[i] == -1)){
  2059.         continue;
  2060.         }
  2061.         target = incrPtr->multAtoms[2*i];
  2062.         incrPtr->idleTime = 0;
  2063.         for (selPtr = incrPtr->winPtr->selHandlerList; ;
  2064.             selPtr = selPtr->nextPtr) {
  2065.         if (selPtr == NULL) {
  2066.             incrPtr->multAtoms[2*i + 1] = None;
  2067.             incrPtr->offsets[i] = -1;
  2068.             incrPtr->numIncrs --;
  2069.             return;
  2070.         }
  2071.         if ((selPtr->target == target)
  2072.             && (selPtr->selection == incrPtr->selection)) {
  2073.             formatType = selPtr->format;
  2074.             if (incrPtr->offsets[i] == -2) {
  2075.             numItems = 0;
  2076.             ((char *) buffer)[0] = 0;
  2077.             } else {
  2078.             InProgress ip;
  2079.             ip.selPtr = selPtr;
  2080.             ip.nextPtr = pendingPtr;
  2081.             pendingPtr = &ip;
  2082.             numItems = (*selPtr->proc)(selPtr->clientData,
  2083.                 incrPtr->offsets[i], (char *) buffer,
  2084.                 TK_SEL_BYTES_AT_ONCE);
  2085.             pendingPtr = ip.nextPtr;
  2086.             if (ip.selPtr == NULL) {
  2087.                 /*
  2088.                  * The selection handler deleted itself.
  2089.                  */
  2090.  
  2091.                 return;
  2092.             }
  2093.             if (numItems > TK_SEL_BYTES_AT_ONCE) {
  2094.                 panic("selection handler returned too many bytes");
  2095.             } else {
  2096.                 if (numItems < 0) {
  2097.                 numItems = 0;
  2098.                 }
  2099.             }
  2100.             ((char *) buffer)[numItems] = '\0';
  2101.             }
  2102.             if (numItems < TK_SEL_BYTES_AT_ONCE) {
  2103.             if (numItems <= 0) {
  2104.                 incrPtr->offsets[i] = -1;
  2105.                 incrPtr->numIncrs--;
  2106.             } else {
  2107.                 incrPtr->offsets[i] = -2;
  2108.             }
  2109.             } else {
  2110.             incrPtr->offsets[i] += numItems;
  2111.             }
  2112.             if (formatType == XA_STRING) {
  2113.             propPtr = (char *) buffer;
  2114.             format = 8;
  2115.             } else {
  2116.             propPtr = (char *) SelCvtToX((char *) buffer,
  2117.                 formatType, (Tk_Window) incrPtr->winPtr,
  2118.                 &numItems);
  2119.             format = 32;
  2120.             }
  2121.             errorHandler = Tk_CreateErrorHandler(
  2122.                 eventPtr->xproperty.display, -1, -1, -1,
  2123.                 (int (*)()) NULL, (ClientData) NULL);
  2124.             XChangeProperty(eventPtr->xproperty.display,
  2125.                 eventPtr->xproperty.window,
  2126.                 eventPtr->xproperty.atom, formatType,
  2127.                 format, PropModeReplace,
  2128.                 (unsigned char *) propPtr, numItems);
  2129.             Tk_DeleteErrorHandler(errorHandler);
  2130.             if (propPtr != (char *) buffer) {
  2131.             ckfree(propPtr);
  2132.             }
  2133.             return;
  2134.         }
  2135.         }
  2136.     }
  2137.     }
  2138. }
  2139.  
  2140. /*
  2141.  *----------------------------------------------------------------------
  2142.  *
  2143.  * HandleTclCommand --
  2144.  *
  2145.  *    This procedure acts as selection handler for handlers created
  2146.  *    by the "selection handle" command.  It invokes a Tcl command to
  2147.  *    retrieve the selection.
  2148.  *
  2149.  * Results:
  2150.  *    The return value is a count of the number of bytes actually
  2151.  *    stored at buffer, or -1 if an error occurs while executing
  2152.  *    the Tcl command to retrieve the selection.
  2153.  *
  2154.  * Side effects:
  2155.  *    None except for things done by the Tcl command.
  2156.  *
  2157.  *----------------------------------------------------------------------
  2158.  */
  2159.  
  2160. static int
  2161. HandleTclCommand(clientData, offset, buffer, maxBytes)
  2162.     ClientData clientData;    /* Information about command to execute. */
  2163.     int offset;            /* Return selection bytes starting at this
  2164.                  * offset. */
  2165.     char *buffer;        /* Place to store converted selection. */
  2166.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  2167. {
  2168.     CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
  2169.     int spaceNeeded, length;
  2170. #define MAX_STATIC_SIZE 100
  2171.     char staticSpace[MAX_STATIC_SIZE];
  2172.     char *command;
  2173.     Tcl_Interp *interp;
  2174.     Tcl_DString oldResult;
  2175.  
  2176.     /*
  2177.      * We must copy the interpreter pointer from CommandInfo because the
  2178.      * command could delete the handler, freeing the CommandInfo data before we
  2179.      * are done using it.
  2180.      */
  2181.  
  2182.     interp = cmdInfoPtr->interp;
  2183.  
  2184.     /*
  2185.      * First, generate a command by taking the command string
  2186.      * and appending the offset and maximum # of bytes.
  2187.      */
  2188.  
  2189.     spaceNeeded = cmdInfoPtr->cmdLength + 30;
  2190.     if (spaceNeeded < MAX_STATIC_SIZE) {
  2191.     command = staticSpace;
  2192.     } else {
  2193.     command = (char *) ckalloc((unsigned) spaceNeeded);
  2194.     }
  2195.     sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
  2196.  
  2197.     /*
  2198.      * Execute the command.  Be sure to restore the state of the
  2199.      * interpreter after executing the command.
  2200.      */
  2201.  
  2202.     Tcl_DStringInit(&oldResult);
  2203.     Tcl_DStringGetResult(interp, &oldResult);
  2204.     if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
  2205.     length = strlen(interp->result);
  2206.     if (length > maxBytes) {
  2207.         length = maxBytes;
  2208.     }
  2209.     memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length);
  2210.     buffer[length] = '\0';
  2211.     } else {
  2212.     length = -1;
  2213.     }
  2214.     Tcl_DStringResult(interp, &oldResult);
  2215.  
  2216.     if (command != staticSpace) {
  2217.     ckfree(command);
  2218.     }
  2219.  
  2220.     return length;
  2221. }
  2222.  
  2223. /*
  2224.  *----------------------------------------------------------------------
  2225.  *
  2226.  * SelTimeoutProc --
  2227.  *
  2228.  *    This procedure is invoked once every second while waiting for
  2229.  *    the selection to be returned.  After a while it gives up and
  2230.  *    aborts the selection retrieval.
  2231.  *
  2232.  * Results:
  2233.  *    None.
  2234.  *
  2235.  * Side effects:
  2236.  *    A new timer callback is created to call us again in another
  2237.  *    second, unless time has expired, in which case an error is
  2238.  *    recorded for the retrieval.
  2239.  *
  2240.  *----------------------------------------------------------------------
  2241.  */
  2242.  
  2243. static void
  2244. SelTimeoutProc(clientData)
  2245.     ClientData clientData;        /* Information about retrieval
  2246.                      * in progress. */
  2247. {
  2248.     register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
  2249.  
  2250.     /*
  2251.      * Make sure that the retrieval is still in progress.  Then
  2252.      * see how long it's been since any sort of response was received
  2253.      * from the other side.
  2254.      */
  2255.  
  2256.     if (retrPtr->result != -1) {
  2257.     return;
  2258.     }
  2259.     retrPtr->idleTime++;
  2260.     if (retrPtr->idleTime >= 5) {
  2261.  
  2262.     /*
  2263.      * Use a careful procedure to store the error message, because
  2264.      * the result could already be partially filled in with a partial
  2265.      * selection return.
  2266.      */
  2267.  
  2268.     Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
  2269.         TCL_STATIC);
  2270.     retrPtr->result = TCL_ERROR;
  2271.     } else {
  2272.     retrPtr->timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
  2273.         (ClientData) retrPtr);
  2274.     }
  2275. }
  2276.  
  2277. /*
  2278.  *----------------------------------------------------------------------
  2279.  *
  2280.  * IncrTimeoutProc --
  2281.  *
  2282.  *    This procedure is invoked once a second while sending the
  2283.  *    selection to a requestor in INCR mode.  After a while it
  2284.  *    gives up and aborts the selection operation.
  2285.  *
  2286.  * Results:
  2287.  *    None.
  2288.  *
  2289.  * Side effects:
  2290.  *    A new timeout gets registered so that this procedure gets
  2291.  *    called again in another second, unless too many seconds
  2292.  *    have elapsed, in which case incrPtr is marked as "all done".
  2293.  *
  2294.  *----------------------------------------------------------------------
  2295.  */
  2296.  
  2297. static void
  2298. IncrTimeoutProc(clientData)
  2299.     ClientData clientData;        /* Information about INCR-mode
  2300.                      * selection retrieval for which
  2301.                      * we are selection owner. */
  2302. {
  2303.     register IncrInfo *incrPtr = (IncrInfo *) clientData;
  2304.  
  2305.     incrPtr->idleTime++;
  2306.     if (incrPtr->idleTime >= 5) {
  2307.     incrPtr->numIncrs = 0;
  2308.     } else {
  2309.     incrPtr->timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
  2310.         (ClientData) incrPtr);
  2311.     }
  2312. }
  2313.  
  2314. /*
  2315.  *----------------------------------------------------------------------
  2316.  *
  2317.  * DefaultSelection --
  2318.  *
  2319.  *    This procedure is called to generate selection information
  2320.  *    for a few standard targets such as TIMESTAMP and TARGETS.
  2321.  *    It is invoked only if no handler has been declared by the
  2322.  *    application.
  2323.  *
  2324.  * Results:
  2325.  *    If "target" is a standard target understood by this procedure,
  2326.  *    the selection is converted to that form and stored as a
  2327.  *    character string in buffer.  The type of the selection (e.g.
  2328.  *    STRING or ATOM) is stored in *typePtr, and the return value is
  2329.  *    a count of the # of non-NULL bytes at buffer.  If the target
  2330.  *    wasn't understood, or if there isn't enough space at buffer
  2331.  *    to hold the entire selection (no INCR-mode transfers for this
  2332.  *    stuff!), then -1 is returned.
  2333.  *
  2334.  * Side effects:
  2335.  *    None.
  2336.  *
  2337.  *----------------------------------------------------------------------
  2338.  */
  2339.  
  2340. static int
  2341. DefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
  2342.     TkSelectionInfo *infoPtr;    /* Info about selection being retrieved. */
  2343.     Atom target;        /* Desired form of selection. */
  2344.     char *buffer;        /* Place to put selection characters. */
  2345.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  2346.     Atom *typePtr;        /* Store here the type of the selection,
  2347.                  * for use in converting to proper X format. */
  2348. {
  2349.     register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
  2350.     TkDisplay *dispPtr = winPtr->dispPtr;
  2351.  
  2352.     if (target == dispPtr->timestampAtom) {
  2353.     if (maxBytes < 20) {
  2354.         return -1;
  2355.     }
  2356.     sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
  2357.     *typePtr = XA_INTEGER;
  2358.     return strlen(buffer);
  2359.     }
  2360.  
  2361.     if (target == dispPtr->targetsAtom) {
  2362.     register TkSelHandler *selPtr;
  2363.     char *atomString;
  2364.     int length, atomLength;
  2365.  
  2366.     if (maxBytes < 50) {
  2367.         return -1;
  2368.     }
  2369.     strcpy(buffer, "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW");
  2370.     length = strlen(buffer);
  2371.     for (selPtr = winPtr->selHandlerList; selPtr != NULL;
  2372.         selPtr = selPtr->nextPtr) {
  2373.         if ((selPtr->selection == infoPtr->selection)
  2374.             && (selPtr->target != dispPtr->applicationAtom)
  2375.             && (selPtr->target != dispPtr->windowAtom)) {
  2376.         atomString = Tk_GetAtomName((Tk_Window) winPtr,
  2377.             selPtr->target);
  2378.         atomLength = strlen(atomString) + 1;
  2379.         if ((length + atomLength) >= maxBytes) {
  2380.             return -1;
  2381.         }
  2382.         sprintf(buffer+length, " %s", atomString);
  2383.         length += atomLength;
  2384.         }
  2385.     }
  2386.     *typePtr = XA_ATOM;
  2387.     return length;
  2388.     }
  2389.  
  2390.     if (target == dispPtr->applicationAtom) {
  2391.     int length;
  2392.     char *name = winPtr->mainPtr->winPtr->nameUid;
  2393.  
  2394.     length = strlen(name);
  2395.     if (maxBytes <= length) {
  2396.         return -1;
  2397.     }
  2398.     strcpy(buffer, name);
  2399.     *typePtr = XA_STRING;
  2400.     return length;
  2401.     }
  2402.  
  2403.     if (target == dispPtr->windowAtom) {
  2404.     int length;
  2405.     char *name = winPtr->pathName;
  2406.  
  2407.     length = strlen(name);
  2408.     if (maxBytes <= length) {
  2409.         return -1;
  2410.     }
  2411.     strcpy(buffer, name);
  2412.     *typePtr = XA_STRING;
  2413.     return length;
  2414.     }
  2415.  
  2416.     return -1;
  2417. }
  2418.  
  2419. /*
  2420.  *----------------------------------------------------------------------
  2421.  *
  2422.  * LostSelection --
  2423.  *
  2424.  *    This procedure is invoked when a window has lost ownership of
  2425.  *    the selection and the ownership was claimed with the command
  2426.  *    "selection own".
  2427.  *
  2428.  * Results:
  2429.  *    None.
  2430.  *
  2431.  * Side effects:
  2432.  *    A Tcl script is executed;  it can do almost anything.
  2433.  *
  2434.  *----------------------------------------------------------------------
  2435.  */
  2436.  
  2437. static void
  2438. LostSelection(clientData)
  2439.     ClientData clientData;        /* Pointer to CommandInfo structure. */
  2440. {
  2441.     LostCommand *lostPtr = (LostCommand *) clientData;
  2442.     char *oldResultString;
  2443.     Tcl_FreeProc *oldFreeProc;
  2444.  
  2445.     /*
  2446.      * Execute the command.  Save the interpreter's result, if any, and
  2447.      * restore it after executing the command.
  2448.      */
  2449.  
  2450.     oldFreeProc = lostPtr->interp->freeProc;
  2451.     if (oldFreeProc != 0) {
  2452.     oldResultString = lostPtr->interp->result;
  2453.     } else {
  2454.     oldResultString = (char *) ckalloc((unsigned)
  2455.         (strlen(lostPtr->interp->result) + 1));
  2456.     strcpy(oldResultString, lostPtr->interp->result);
  2457.     oldFreeProc = (Tcl_FreeProc *) free;
  2458.     }
  2459.     lostPtr->interp->freeProc = 0;
  2460.     if (TkCopyAndGlobalEval(lostPtr->interp, lostPtr->command) != TCL_OK) {
  2461.     Tk_BackgroundError(lostPtr->interp);
  2462.     }
  2463.     Tcl_FreeResult(lostPtr->interp);
  2464.     lostPtr->interp->result = oldResultString;
  2465.     lostPtr->interp->freeProc = oldFreeProc;
  2466.  
  2467.     /*
  2468.      * Free the storage for the command, since we're done with it now.
  2469.      */
  2470.  
  2471.     ckfree((char *) lostPtr);
  2472. }
  2473.  
  2474. /*
  2475.  *----------------------------------------------------------------------
  2476.  *
  2477.  * SelectionSize --
  2478.  *
  2479.  *    This procedure is called when the selection is too large to
  2480.  *    send in a single buffer;  it computes the total length of
  2481.  *    the selection in bytes.
  2482.  *
  2483.  * Results:
  2484.  *    The return value is the number of bytes in the selection
  2485.  *    given by selPtr.
  2486.  *
  2487.  * Side effects:
  2488.  *    The selection is retrieved from its current owner (this is
  2489.  *    the only way to compute its size).
  2490.  *
  2491.  *----------------------------------------------------------------------
  2492.  */
  2493.  
  2494. static int
  2495. SelectionSize(selPtr)
  2496.     TkSelHandler *selPtr;    /* Information about how to retrieve
  2497.                  * the selection whose size is wanted. */
  2498. {
  2499.     char buffer[TK_SEL_BYTES_AT_ONCE+1];
  2500.     int size, chunkSize;
  2501.     InProgress ip;
  2502.  
  2503.     size = TK_SEL_BYTES_AT_ONCE;
  2504.     ip.selPtr = selPtr;
  2505.     ip.nextPtr = pendingPtr;
  2506.     pendingPtr = &ip;
  2507.     do {
  2508.     chunkSize = (*selPtr->proc)(selPtr->clientData, size,
  2509.             (char *) buffer, TK_SEL_BYTES_AT_ONCE);
  2510.     if (ip.selPtr == NULL) {
  2511.         size = 0;
  2512.         break;
  2513.     }
  2514.     size += chunkSize;
  2515.     } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
  2516.     pendingPtr = ip.nextPtr;
  2517.     return size;
  2518. }
  2519.